home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Special 23
/
AMIGAplus Sonderheft 23 (2000)(Falke)(DE)[!].iso
/
Rexx
/
VectorText.pprx
< prev
next >
Wrap
Text File
|
1999-11-06
|
7KB
|
269 lines
/* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
/* $VER: VectorText.pprx 1.1 */
/** ENG
This script renders a vector text in the current environment.
A requester allows the user to select several parameters, such as
font, text string, angle, shear angle, bold level, antialiasing, etc.
The text is drawn using the current foreground color.
*/
/** DEU
Mit diesem Skript läßt sich ein Vektortext in der aktuellen
Umgebung erzeugen. Das dazugehörige Dialogfenster enthält
Einstellmöglichkeiten für verschiedene Parameter, wie Font,
Textstring, Winkel, Neigungsgrad, Stärke, Kantenglättung,
usw. Die Textdarstellung erfolgt in der aktuellen Vordergrundfarbe.
*/
/** ITA
Questo script compone un testo vettoriale nell'ambiente corrente.
Una finestra di dialogo permette di selezionare diversi parametri, come
font, stringa di testo, angolo, inclinazione, spessore, smorzamento
seghettature (antialiasing), ecc. Il testo viene scritto utilizzando
l'attuale colore di primo piano.
*/
IF ARG(1, EXISTS) THEN
PARSE ARG PPPORT x0 y0 rwidth rheight .
ELSE
EXIT 0 /* macro execution only */
ADDRESS VALUE PPPORT
OPTIONS RESULTS
OPTIONS FAILAT 10000
Get 'LANG'
IF RESULT = 1 THEN DO /* Deutsch */
txt_title_req = "Texteinstellungen"
txt_gad_font = "_Font:"
txt_gad_text = "_Text:"
txt_string_text = "Text"
txt_gad_angle = "Wink_el:"
txt_gad_shear = "_Neigung:"
txt_gad_boldx = "Stärke _X:"
txt_gad_boldy = "Stärke _Y:"
txt_gad_aalias = "_Kantenglättung:"
txt_gad_aalias0 = "Keine"
txt_gad_aalias1 = "Schwach"
txt_gad_aalias2 = "Mittel"
txt_gad_aalias3 = "Stark"
txt_gad_kratio = "_Verhältnis erhalten:"
txt_gad_kbline = "_Grundlinie erhalten:"
txt_err_oldclient = "Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich"
txt_err_nofonts = "Vektorfonts nicht auffindbar"
txt_err_vtext = "VektorText-Fehler: "
END
ELSE IF RESULT = 2 THEN DO /* Italiano */
txt_title_req = "Parametri testo"
txt_gad_font = "_Font:"
txt_gad_text = "_Testo:"
txt_string_text = "Testo"
txt_gad_angle = "Ang_olo:"
txt_gad_shear = "In_clinazione:"
txt_gad_boldx = "Grassetto _X:"
txt_gad_boldy = "Grassetto _Y:"
txt_gad_aalias = "Antialia_s:"
txt_gad_aalias0 = "Nessuno"
txt_gad_aalias1 = "Basso"
txt_gad_aalias2 = "Medio"
txt_gad_aalias3 = "Alto"
txt_gad_kratio = "Asp_etto:"
txt_gad_kbline = "Linea di _base:"
txt_err_oldclient = "Questa procedura richiede_una versione più recente_di Personal Paint"
txt_err_nofonts = "Non vi sono font vettoriali"
txt_err_vtext = "Errore comando VectorText: "
END
ELSE DO /* English */
txt_title_req = "Text Settings"
txt_gad_font = "_Font:"
txt_gad_text = "_Text:"
txt_string_text = "Text"
txt_gad_angle = "_Angle:"
txt_gad_shear = "_Shear:"
txt_gad_boldx = "Bold _X:"
txt_gad_boldy = "Bold _Y:"
txt_gad_aalias = "A_ntialias:"
txt_gad_aalias0 = "None"
txt_gad_aalias1 = "Low"
txt_gad_aalias2 = "Medium"
txt_gad_aalias3 = "High"
txt_gad_kratio = "Keep _Ratio:"
txt_gad_kbline = "Keep _Baseline:"
txt_err_oldclient = "This script requires a newer_version of Personal Paint"
txt_err_nofonts = "Vector fonts not found"
txt_err_vtext = "VectorText error: "
END
Version 'REXX'
IF RESULT < 7 THEN DO
RequestNotify 'PROMPT "'txt_err_oldclient'"'
EXIT 10
END
def_font_path = "FONTS:"
max_text_size = 8000
font_path = LoadSet('PP_VectorPath', def_font_path, 1, 0)
ftot = 0
vftfname = 'ENV:PP_VectorFonts'
IF ~OPEN(fexists, vftfname) THEN DO
ADDRESS COMMAND 'List >'vftfname' 'font_path' PAT=#?.otag NOHEAD LFORMAT="%s"'
ADDRESS COMMAND 'Sort 'vftfname vftfname'.s'
IF RC = 0 THEN DO
ADDRESS COMMAND 'Delete >NIL: 'vftfname
ADDRESS COMMAND 'Copy >NIL: 'vftfname'.s' vftfname
ADDRESS COMMAND 'Delete >NIL: 'vftfname'.s'
END
END
ELSE CALL CLOSE(fexists)
IF OPEN('listfile', vftfname) THEN DO
DO FOREVER
fline = READLN('listfile')
IF EOF('listfile') THEN BREAK
ftot = ftot + 1
fontname.ftot = LEFT(fline, LENGTH(fline) - 5)
END
CALL CLOSE('listfile')
END
IF ftot = 0 THEN DO
RequestNotify 'PROMPT "'txt_err_nofonts'"'
EXIT 10
END
fntnum = LoadSet('Font', 0)
text = LoadSet('Text', txt_string_text)
angle = LoadSet('Angle', 0)
shear = LoadSet('Shear', 0)
boldx = LoadSet('BoldX', 0)
boldy = LoadSet('BoldY', 0)
aalias = LoadSet('Antialias', 0)
kratio = LoadSet('KeepRatio', 0)
kbline = LoadSet('KeepBaseline', 0)
req = '"LIST = ""'txt_gad_font'"", 'ftot', 'fntnum', 20, 5'
DO f = 1 TO ftot
req = req || ', ""' || fontname.f || '""'
END
req = req ||,
' VSPACE = 2 ' ||,
'STRING = ""'txt_gad_text'"", 'max_text_size', ""'text'"" ' ||,
'VSPACE = 2 ' ||,
'SLIDE = ""'txt_gad_angle'"", -360, 360, 'angle' ' ||,
'SLIDE = ""'txt_gad_shear'"", -45, 45, 'shear' ' ||,
'SLIDE = ""'txt_gad_boldx'"", -8, 8, 'boldx' ' ||,
'SLIDE = ""'txt_gad_boldy'"", -8, 8, 'boldy' ' ||,
'VSPACE = 2 ' ||,
'CYCLE = ""'txt_gad_aalias'"", 4, 'aalias', ""'txt_gad_aalias0'"", ""'txt_gad_aalias1'"", ""'txt_gad_aalias2'"", ""'txt_gad_aalias3'"" ' ||,
'CHECK = ""'txt_gad_kratio'"", 'kratio' ' ||,
'CHECK = ""'txt_gad_kbline'"", 'kbline' ' ||,
'VSPACE = 2 "'
LockGUI
Request 'RESIZE COMPACT "'txt_title_req'" 'req
IF RC = 0 THEN DO
fntnum = RESULT.1 + 1
text = RESULT.2
angle = RESULT.3
shear = RESULT.4
boldx = RESULT.5
boldy = RESULT.6
aalias = RESULT.7
kratio = RESULT.8
kbline = RESULT.9
CALL SaveSet('Font', fntnum - 1) /* setting persistence */
CALL SaveSet('Text', text)
CALL SaveSet('Angle', angle)
CALL SaveSet('Shear', shear)
CALL SaveSet('BoldX', boldx)
CALL SaveSet('BoldY', boldy)
CALL SaveSet('Antialias', aalias)
CALL SaveSet('KeepRatio', kratio)
CALL SaveSet('KeepBaseline', kbline)
options = 'DYNAMIC'
IF kratio THEN
options = options 'KEEPRATIO'
IF kbline THEN
options = options 'KEEPBASELINE'
/* encode quotes */
pos = 1
DO FOREVER
pos = INDEX(text, '"', pos)
IF pos = 0 THEN
BREAK
text = INSERT('"', text, pos)
pos = pos + 2
END
VectorText 'TEXT "'text'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" X0 'x0' Y0 'y0' X1 'x0 + rwidth - 1' Y1 'y0 + rheight - 1' ANGLE 'angle * 1000' SHEAR 'shear * 1000' BOLDX 'boldx * 1000' BOLDY 'boldy * 1000' ANTIALIAS 'aalias options
IF RC > 5 THEN
RequestNotify 'PROMPT "'txt_err_vtext || RC'"'
END
UnlockGUI
EXIT 0
SaveSet:
sname = ARG(1)
val = ARG(2)
IF OPEN('settingfile', 'ENV:PP_VectorText_'sname, 'W') THEN DO
CALL WRITECH('settingfile', val)
CALL CLOSE('settingfile')
END
RETURN
LoadSet:
sname = ARG(1)
def_val = ARG(2)
IF ARG() > 2 THEN
global_set = ARG(3)
ELSE
global_set = 0
IF ARG() > 3 THEN
request_quote = ARG(4)
ELSE
request_quote = 1
val = def_val
IF global_set THEN
set_fname = 'ENV:'sname
ELSE
set_fname = 'ENV:PP_VectorText_'sname
IF OPEN('settingfile', set_fname, 'R') THEN DO
val = READCH('settingfile', 65535)
CALL CLOSE('settingfile')
END
IF request_quote THEN DO
/* encode quotes for the Request command ('"' -> '\""') */
qpos_start = 1
DO FOREVER
qpos = INDEX(val, '"', qpos_start)
IF qpos = 0 THEN BREAK
val = INSERT('\"', val, qpos-1)
qpos_start = qpos + 3
END
END
RETURN val